perm filename FPRINT.IL[TIM,LSP]1 blob sn#679567 filedate 1982-09-23 generic text, type C, neo UTF8
COMMENT āŠ—   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	 BENCHMARK TO PRINT TO A FILE.
C00006 ENDMK
CāŠ—;
;;; BENCHMARK TO PRINT TO A FILE.
(DECLARE (LOCALVARS . T)(GLOBALVARS TEST-ATOMS TEST-PATTERN))

(RPAQ TEST-ATOMS '(ABCDEF12 CDEFGH23 EFGHIJ34 GHIJKL45 IJKLMN56 KLMNOP67 
			    MNOPQR78 OPQRST89 QRSTUV90 STUVWX01 UVWXYZ12 
			    WXYZAB23 XYZABC34 123456AB 234567BC 345678CD 
			    456789DE 567890EF 678901FG 789012GH 890123HI))

(RPAQ TEST-PATTERN (INIT 6. 6. TEST-ATOMS))

(COND ((PROBEF "FPRINT.TST"))
      (T 
       (LET ((F (OPEN "FPRINT.TST" '(OUT ASCII))))
	    (PRINT TEST-PATTERN F)
	    (CLOSE F))))



(DEFINEQ
  (INIT
   (LAMBDA (M N ATOMS) 
     ((LAMBDA (ATOMS) 
	((LAMBDA (G0014) 
	   (PROG (A) 
		 (SETQ A G0014)
	    LOOP (COND ((NULL (CDR A)) (RETURN (RPLACD A ATOMS))))
		 ((LAMBDA (G0014) (SETQ A G0014) (GO LOOP)) (CDR A))))
	 ATOMS)
	(INIT1 M N ATOMS))
      (SUBST NIL NIL ATOMS)))))

(DEFINEQ
  (INIT1
   (LAMBDA (M N ATOMS) 
     (COND
      ((IEQP M 0) (PROG1 (CAR ATOMS) (SETQ ATOMS (CDR ATOMS))))
      (T
       ((LAMBDA (G0015 G0016) 
	  (PROG (I A) 
		(PROGN (SETQ I G0015) (SETQ A G0016))
	   LOOP	(COND ((ILESSP I 1) (RETURN A)))
		(SETQ A (CONS
			 (PROG1 (CAR ATOMS) (SETQ ATOMS (CDR ATOMS)))
			 A))
		(SETQ A (CONS (INIT1 (IDIFFERENCE M 1) N ATOMS) A))
		((LAMBDA (G0015) (SETQ I G0015) (GO LOOP))
		 (IDIFFERENCE I 2))))
	N
	NIL))))))

(DEFINEQ
  (FPRINT
   (LAMBDA NIL 
     (DELFILE "FPRINT.TST")))
     ((LAMBDA (F) (PRINT TEST-PATTERN F) (CLOSE F))
      (OPENFILE "FPRINT.TST" 'OUTPUT))))))

(TIMER TIMIT (FPRINT))